Amiga Collections: Panorama/Panorama - Disk 28C (1988-04-27)(Pacific North-West Amigas Club)[WB].zip/Panorama - Disk 28C (1988-04-27)(Pacific North-West Amigas Club)[WB].adf/ModulaII/Etchm2/EtchAsketch.Mod

Text File | 1987-12-24 | 6KB | 204 lines

MODULE EtchAsketch;
(*********************************************************)
(*                    EtchAsketch                        *)
(*                                                       *)
(*    A program to demonstrate the use of the joystick   *)
(*             device and hardware sprites.              *)
(*                                                       *)
(*        Written for the Benchmark M2 compiler.         *)
(*                                                       *)
(*  Steve Faiwiszewski                    December 1987  *)
(*                                                       *)
(*********************************************************)

FROM EtchGlobal   IMPORT AddTerminationProc, ExitGracefully,
                         MyVPort, MyRPort, ChipAllocate;
FROM EtchJoystick IMPORT OpenJoystick, GetJoystickStatus,
                         ListenToJoystick,  Left, Right,
                         PrepareToReadJoystick,
                         SetTriggerTime, Forward, Backward;
FROM EtchIntuiStuff
                 IMPORT ListenToIntuition, SetSpriteColors,
                        ProcessIntuiMessages;
FROM Tasks       IMPORT SignalSet, Wait;
FROM Drawing     IMPORT Move, Draw, SetAPen,PolyDraw, SetDrMd,
                        RectFill, ReadPixel;
FROM Sprites     IMPORT SimpleSprite, GetSprite, ChangeSprite,
                        FreeSprite, MoveSprite, AnySprite;
FROM Gels        IMPORT InitGels, GelsInfoPtr, VSprite,
                        VSpritePtr;
FROM Rasters     IMPORT RastPortPtr;
FROM TermInOut   IMPORT WriteString, WriteLn;
FROM SYSTEM      IMPORT TSIZE;

CONST
   SpriteHeight = 5;
   SpriteCenterOffset = (SpriteHeight DIV 2);
   Xinc = 1;
   Yinc = 1;
   Xmin = SpriteCenterOffset;
   Ymin = 5;
   Xmax = 320 - Xmin;
   Ymax = 190 - Ymin;

TYPE
    DirectionType = (up,down,left,right);
    DirectionSet  = SET OF DirectionType;

    SpriteImageBuf = RECORD
        data : ARRAY[0..SpriteHeight+1],[0..1] OF CARDINAL;
    END;

VAR
    SpriteImagePtr : POINTER TO SpriteImageBuf;
    MySignalSet    : SignalSet;
    MySprite       : SimpleSprite;
    CurX, CurY,
    StolenSprite   : INTEGER;

PROCEDURE GetDirection(VAR NewDirection : DirectionSet;
                       VAR ButtonDown : BOOLEAN);
(* Get Joystick directions and button press *)
VAR
    Ystick,
    Xstick : INTEGER;
BEGIN
    GetJoystickStatus(ButtonDown,Xstick,Ystick);
    NewDirection := DirectionSet{};
    CASE Ystick OF
        Forward  : INCL(NewDirection,up)        |
        Backward : INCL(NewDirection,down)
        ELSE    (* do nothing *)
    END; (* case *)
    CASE Xstick OF
        Left  : INCL(NewDirection,left)         |
        Right : INCL(NewDirection,right)
        ELSE    (* do nothing *)
    END; (* case *)
END GetDirection;

PROCEDURE Allowed(NewDirection : DirectionType) : BOOLEAN;
(* Check if requested movement is allowed *)
BEGIN
    CASE NewDirection OF
        up   : RETURN CurY >= Ymin + Yinc                |
        down : RETURN CurY <= Ymax - Yinc                |
        left : RETURN CurX >= Xmin + Xinc                |
        right: RETURN CurX <= Xmax - Xinc
        ELSE
               RETURN FALSE
    END; (* case *)
END Allowed;


PROCEDURE MovePlayer(NewDirection : DirectionSet;
                     ButtonDown : BOOLEAN);
(* Move the sprite in the requested direction *)
(* only if move is legal.                     *)
VAR
    dir : DirectionType;
BEGIN
    IF NewDirection <> DirectionSet{} THEN
        FOR dir := up TO right DO
            IF (dir IN NewDirection) AND Allowed(dir) THEN
                CASE dir OF
                    up   : DEC(CurY,Yinc)  |
                    down : INC(CurY,Yinc)  |
                    left : DEC(CurX,Xinc)  |
                    right: INC(CurX,Xinc)
                END;
            END; (* if *)
        END; (* for *)
        IF ButtonDown THEN
            Draw(MyRPort^,CurX + SpriteCenterOffset,
                          CurY + SpriteCenterOffset);
        ELSE
            Move(MyRPort^,CurX + SpriteCenterOffset,
                          CurY + SpriteCenterOffset);
        END;
        MoveSprite(MyVPort^,MySprite,CurX,CurY);
    END;
END MovePlayer;

PROCEDURE LoopAround;
(* Listen for Joystick and Intuition Events, *)
(* and process them.                         *)
VAR
    sig : SignalSet;
    Directions : DirectionSet;
    exiting,
    ButtonDown : BOOLEAN;
BEGIN
    exiting := FALSE;
    ButtonDown := FALSE;
    REPEAT
        PrepareToReadJoystick;
        sig := Wait(MySignalSet);
        ProcessIntuiMessages(exiting);
        GetDirection(Directions,ButtonDown);
        MovePlayer(Directions,ButtonDown)
    UNTIL exiting;
END LoopAround;

PROCEDURE InitSpriteImage;
(* Set up the sprite's image.  Must be in Chip RAM. *)
VAR
    i : CARDINAL;
BEGIN
    ChipAllocate(SpriteImagePtr,TSIZE(SpriteImageBuf));
(* We only need to initialize non-zero data, as  *)
(* ChipAllocate initialized the allocated memory *)
    WITH SpriteImagePtr^ DO
        data[1,0] := 2000H;
        data[2,0] := 7000H;        data[2,1] := 2000H;
        data[3,0] := 0D800H;        data[3,1] := 5000H;
        data[4,0] := 7000H;        data[4,1] := 2000H;
        data[5,0] := 2000H;
    END; (* with *)
END InitSpriteImage;

PROCEDURE PrepareSprite;
(* Obtain a hardware sprite and set it up *)
BEGIN
    InitSpriteImage;
    StolenSprite := GetSprite(MySprite,AnySprite);
    IF StolenSprite = -1 THEN
        WriteString('** Could not obtain sprite! **');
        WriteLn;
        ExitGracefully
    END;
    SetSpriteColors(StolenSprite);
    CurX := (Xmax - Xmin) DIV 2 + Xmin;
    CurY := (Ymax - Ymin) DIV 2 + Ymin;
    WITH MySprite DO
        height := SpriteHeight;
        x := CurX;
        y := CurY;
    END;
    ChangeSprite(MyVPort^,MySprite,SpriteImagePtr);
    Move(MyRPort^,CurX + SpriteCenterOffset,
                  CurY + SpriteCenterOffset);
END PrepareSprite;

PROCEDURE cleanup;
(* Release the hardware sprite *)
BEGIN
    FreeSprite(StolenSprite)
END cleanup;

BEGIN
    PrepareSprite;
    AddTerminationProc(cleanup);
    OpenJoystick;
    MySignalSet := SignalSet{};
    ListenToIntuition(MySignalSet);
    ListenToJoystick(MySignalSet);
    IF NOT SetTriggerTime(1) THEN
        WriteString('** error setting trigger **');
        WriteLn;
        ExitGracefully
    END;
    LoopAround;
    ExitGracefully
END EtchAsketch.